;;########################################################################
;; unimob.lsp
;; code for univariate analysis model object (1 of 3)
;; file contains constructor, defproto, isnew and slot accessors
;; Copyright (c) 1995-8 by Forrest W. Young
;;########################################################################

;Constructor Function

(defun univariate-analysis  
  (&key
   (data current-data)
   (title "Univariate Analysis")
   (name nil)
   (dialog nil)
   (variable (first (send current-data :active-variables '(numeric))))
   (class nil)
   (mu 0)
   (sigma nil)
   (direction 0)
   (ci-level .95)
   ) 
"Args:(dialog nil) (data current-data) (title Univariate Analysis)
      (name nil)
      (variable (first (send current-data :active-variables '(numeric))))
      (class nil) (mu 0) (sigma nil)  (direction 0)  (ci-level .95) 
Performs Univariate-Analysis. Data must be multivariate data (table data no longer supported). Analyses include 
1) Single sample analysis, obtained when VARIABLE is the name of a numeric variable, and class is nil.
2) Paired samples analysis, obtained when VARIABLE is a list of two numeric variable names, and class is nil
3) Independent samples analysis, obtained when VARIABLE is the name of a numeric variable, and CLASS is the name of a  binary variable.

By default VARIABLE is the first active numeric variable, and CLASS is nil, producing a single sample analysis of the first active numeric variable.

When DIALOG=t a dialog box is presented to obtain argument values. When DIALOG is false (the default) the indicated argument defaults are used unless overridden. MU is the hypothesized population mean value for a single sample, mean difference for two samples. SIGMA is the population standard deviation (not used for independent samples). DIRECTION must be -1 for negative one-tailed tests, 0 for two-tailed, or 1 for positive two-tailed tests. CI-LEVEL specifies the confidence level."

  (if (not (eq current-object data)) (setcd data))
  (if (send current-data :ways)
      (fatal-message "Univariate Analysis no longer possible with table data. Use the CREATE DATA item of the DATA menu to convert the data to classification data, and analyze the converted data.")
      (let* ((cd current-data)
             (ok-types '(numeric category))
             (univar-mod (send univar-model-object-proto
                               :new variable class mu sigma
                               direction ci-level 
                               "UniVar" data title name dialog
                               ok-types))
             (varnames (send univar-mod :real-varnames))
             (anova-resp (send univar-mod :anova-response))
             (anova-class (send univar-mod :anova-class))
             (type1 (send univar-mod :var1-type))
             (type2 (send univar-mod :var2-type))
             (types (combine type1 type2))
             (temp-data)
             (anova-mod)
             )
;for paired and independent two-sample designs, do hidden anova
;so that the visualization can be used.
        (when (and anova-resp anova-class)
              (send *workmap* :start-buffering)
              (cond
                ((member "Binary" types :test #'equal)
                 (setf temp-data cd))
                (t
;for paired design, generate hidden data appropriate to anova
                 (setf temp-data
                       (data "hidden" 
                             :iconify nil
                             :variables (list name "Class")
                             :types (list "Numeric" "Category")
                             :data (combine 
                                    (row-list 
                                     (bind-columns anova-resp 
                                                   anova-class)))))
                 (set-current-data-variables temp-data)
                 ))
              (setf anova-mod
                    (send anova-model-object-proto 
                          :new nil "ANOVA" temp-data title name nil ok-types
                          :hide-icon t
                          :response anova-resp
                          :class anova-class))
              (send univar-mod :anova-model anova-mod)
              (send anova-mod :model-abbrev "Uni")
              (set-current-data-variables cd)
              (setcm univar-mod)
              )
        (reset-graphics-buffer)
        (send interpret-model-menu-item :enabled t)
        univar-mod)))

; prototype inheriting from mv-model-object-proto

(defproto univar-model-object-proto 
  '(var var1 var2 real-varnames mu sigma t-p-level direction ci-level  
    n-ways t-value t-df t-dfi t-ci-limits paired std-err-diff 
    pooled-variance nonpar nonpar-z nonpar-p mann-whitney-sum 
    var1-label var2-label var1-type var2-type 
	anova-model anova-response anova-class)
  () mv-model-object-proto)


; isnew Method 

(defmeth univar-model-object-proto :isnew 
  (variable class mu sigma direction ci-level &rest args) 

  (let ((n-ways (length (send current-data :ways))))
    (cond
      ((< (send current-data :active-nvar '(numeric)) 1)
;fwy4.28 changed next function to fatal-message for gms to work
       (fatal-message "There are no active numeric variables in the data.")
       (send *toolbox* :reset-button (first args)))
;fwy4.28 changed next function to fatal-message for gms to work
      ((> n-ways 1) (fatal-message "Multi-Way table data are not appropriate for Univariate Analysis. Try Analysis of Variance instead.")
       (send *toolbox* :reset-button (first args)))
      (t
       (when (= n-ways 1) 
             (when (> (length (first (send current-data :classes))) 2)
                   (send *toolbox* :reset-button (first args))
;fwy4.28 changed next function to fatal-message for gms to work
                   (fatal-message "One-Way table data may only have 2 levels (classes) for Univariate Analysis. Try Analysis of Variance.")))
       (send self :model-abbrev "Uni")
       (send self :var (send current-data :data))
       (send self :real-varnames (if class (list variable class)
                                     (if (listp variable) variable (list variable))))
       (send self :mu mu)
       (send self :sigma sigma)
       (send self :direction direction)
       (send self :ci-level ci-level)
       (send self :n-ways n-ways)
       ;(send create-dataobjects-model-popup-menu-item :enabled nil)
       (send create-dataobjects-model-menu-item :enabled nil)
       (cond 
         ((> n-ways 0)
          (send self :var  (send current-data :data))
          (send self :var1 (first (send self :var)))
          (send self :var2 (second (send self :var))))
         ((and (stringp variable) class)
          (send self :var  (combine (send current-data :variable variable)))
          (send self :var1 (send self :var)) 
          (send self :var2 (send current-data :variable class))
          (send self :var1-type "Numeric")
          (send self :var2-type "Binary")
          (send self :var1-label variable)
          (send self :var2-label class)
          (send self :anova-response variable)
          (send self :anova-class class)
          )
         ((stringp variable)
          (send self :var  (combine (send current-data :variable variable)))
          (send self :var1 (send self :var)) 
          (send self :var1-type "Numeric")
          (send self :var1-label variable))
         ((and (stringp (first variable)) (stringp (second variable)))
          (let ((var1 (send current-data :variable (first  variable)))
                (var2 (send current-data :variable (second variable))))
            
            (send self :paired t)
            (send self :var (- var1 var2))
           ; (send self :var (- (send current-data :variable (first variable))
           ;                  (send current-data :variable (second variable))))
            (send self :anova-response (combine var1 var2))
            (send self :anova-class 
                  (combine (repeat (first variable) (length var1))
                           (repeat (second variable) (length var2))))
            (send self :var1-type "Numeric")
            (send self :var2-type "Numeric")
            (send self :var1-label (first variable))
            (send self :var2-label (second variable))
            (send self :var1 var1)
            (send self :var2 var2) 
            (send self :var1 (send current-data :variable (first variable)))
            (send self :var2 (send current-data :variable (second variable)))))
          (t (error "Analysis variable(s) not specified correctly.")))
       (apply #'call-next-method args)
       (send *toolbox* :reset-button (first args))))))

;slot accessor methods

(defmeth univar-model-object-proto :var (&optional (list nil set))
"Message args: (&optional list)
Sets or retrieves the data that are analyzed.  These are the sample values (when there is one sample), sample differences (for two paired samples) or values for both samples (for two independent samples)." 
  (if set (setf (slot-value 'var) list))
  (slot-value 'var))

(defmeth univar-model-object-proto :real-varnames (&optional (list nil set))
"Message args: (&optional list)
Sets or retrieves names of the one or two variables that are really in the data object." 
  (if set (setf (slot-value 'real-varnames) list))
  (slot-value 'real-varnames))

(defmeth univar-model-object-proto :var1 (&optional (list nil set))
"Message args: (&optional list)
Sets or retrieves values for the first sample." 
  (if set (setf (slot-value 'var1) list))
  (slot-value 'var1))

(defmeth univar-model-object-proto :var2 (&optional (list nil set))
"Message args: (&optional list)
Sets or retrieves values for the second sample, if there is one." 
  (if set (setf (slot-value 'var2) list))
  (slot-value 'var2))

(defmeth univar-model-object-proto :mu (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the population mean." 
  (if set (setf (slot-value 'mu) number))
  (slot-value 'mu))

(defmeth univar-model-object-proto :sigma (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the population standard-deviation." 
  (if set (setf (slot-value 'sigma) number))
  (slot-value 'sigma))

(defmeth univar-model-object-proto :t-df (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the degrees of freedom." 
  (if set (setf (slot-value 't-df) number))
  (slot-value 't-df))

(defmeth univar-model-object-proto :t-dfi (&optional (list nil set))
"Message args: (&optional list)
Sets or retrieves the list of three ways to estimate degrees of freedom for independent groups." 
  (if set (setf (slot-value 't-dfi) list))
  (slot-value 't-dfi))

(defmeth univar-model-object-proto :t-value (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the t-value." 
  (if set (setf (slot-value 't-value) number))
  (slot-value 't-value))

(defmeth univar-model-object-proto :t-p-level (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the p-level for the t-value." 
  (if set (setf (slot-value 't-p-level) number))
  (slot-value 't-p-level))

(defmeth univar-model-object-proto :direction (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the direction. Negative or positive for a one-tailed directional test, zero or nil for a two-tailed test." 
  (if set (setf (slot-value 'direction) number))
  (slot-value 'direction))

(defmeth univar-model-object-proto :ci-level (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the t value confidence interval level." 
  (if set (setf (slot-value 'ci-level) number))
  (slot-value 'ci-level)) 

(defmeth univar-model-object-proto :n-ways (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the number of ways of table data (0 for mv data)." 
  (if set (setf (slot-value 'n-ways) number))
  (slot-value 'n-ways)) 

(defmeth univar-model-object-proto :t-ci-limits (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the t value confidence interval limits." 
  (if set (setf (slot-value 't-ci-limits) number))
  (slot-value 't-ci-limits)) 

(defmeth univar-model-object-proto :std-err-diff (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the standard error of the difference of two independent samples." 
  (if set (setf (slot-value 'std-err-diff) number))
  (slot-value 'std-err-diff))

(defmeth univar-model-object-proto :pooled-variance 
  (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the pooled variance for two independent samples." 
  (if set (setf (slot-value 'pooled-variance) number))
  (slot-value 'pooled-variance))

(defmeth univar-model-object-proto :paired (&optional (logical nil set))
"Message args: (&optional logical)
Sets or retrieves whether situation is paired samples." 
  (if set (setf (slot-value 'paired) logical))
  (slot-value 'paired))

(defmeth univar-model-object-proto :nonpar (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the value of the nonparametric test statistic (Wilcoxon T or Mann-Whitney U)." 
  (if set (setf (slot-value 'nonpar) number))
  (slot-value 'nonpar))

(defmeth univar-model-object-proto :nonpar-z (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the value of the large sample normal approximation to the nonparametric statistic." 
  (if set (setf (slot-value 'nonpar-z) number))
  (slot-value 'nonpar-z))

(defmeth univar-model-object-proto :nonpar-p (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the significance level of the large sample normal approximation to nonparametric statistic." 
  (if set (setf (slot-value 'nonpar-p) number))
  (slot-value 'nonpar-p))

(defmeth univar-model-object-proto :mann-whitney-sum 
  (&optional (number nil set))
"Message args: (&optional number)
Sets or retrieves the mann-whitney sum statistic." 
  (if set (setf (slot-value 'mann-whitney-sum) number))
  (slot-value 'mann-whitney-sum))

(defmeth univar-model-object-proto :var1-label 
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the label of the first variable." 
  (if set (setf (slot-value 'var1-label) string))
  (slot-value 'var1-label))

(defmeth univar-model-object-proto :var2-label 
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the label of the second variable." 
  (if set (setf (slot-value 'var2-label) string))
  (slot-value 'var2-label))

(defmeth univar-model-object-proto :var1-type 
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the type of the first variable." 
  (if set (setf (slot-value 'var1-type) string))
  (slot-value 'var1-type))

(defmeth univar-model-object-proto :var2-type 
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the type of the second variable." 
  (if set (setf (slot-value 'var2-type) string))
  (slot-value 'var2-type))

(defmeth univar-model-object-proto :anova-model
  (&optional (anova-model nil set))
"Message args: (&optional anova-model)
Sets or retrieves the type of the second variable." 
  (if set (setf (slot-value 'anova-model) anova-model))
  (slot-value 'anova-model))

(defmeth univar-model-object-proto :anova-response
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the label of the second variable." 
  (if set (setf (slot-value 'anova-response) string))
  (slot-value 'anova-response))

(defmeth univar-model-object-proto :anova-class
  (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the label of the second variable." 
  (if set (setf (slot-value 'anova-class) string))
  (slot-value 'anova-class))

;(load (strcat *vista-dir-name* "unimob1"))